Attribute VB_Name = "ModError"
'************************************************************************************
'*****          AUTHOR:     ANTHONY PATTON
'*****          DATE:       03-09-2002
'*****          FUNCTION:   THIS IS A TREE ERROR HANDLER
'*****          COMMENTS:   WHENEVER AN ERROR IS RAISED, THE ERROR IS APPENDED
'*****                      TO THE ERROR COLLECTION, UNTIL THE MAIN CONTROLING
'*****                      FUNCTION FOR THE APPLICATION RAISES AN ERROR AND THEN
'*****                      THE TREE IS DUMPED TO A STRING BY THE WALKERRORTREE
'*****                      FUNCTION.
'************************************************************************************
Public ErrorTree As New Collection
Dim ErrorTreeStruct As New Collection
Option Explicit
'************************************************************************************
'*****          AUTHOR:     ANTHONY PATTON
'*****          DATE:       03-09-2002
'*****          FUNCTION:   APPENDS AN ERROR TO THE ERROR TREE
'*****          COMMENTS:   ADDS A NODE TO THE ERROR TREE THAT CONSTAINS
'*****                      THE DATE/TIME, DESC, NUMBER AND SOURCE OF THE ERROR
'************************************************************************************
Public Function AppendToErrorTree(ByVal sErrorDesc As String, _
                                  ByVal sErrorNum As String, _
                                  ByVal sErrorSource As String) As Boolean

    On Error GoTo PROC_ERROR
    Dim bResursion As Boolean
    Set ErrorTreeStruct = Nothing
    Set ErrorTreeStruct = New Collection
    
    ErrorTreeStruct.Add sErrorDesc, "DESC"
    ErrorTreeStruct.Add sErrorNum, "NUMBER"
    ErrorTreeStruct.Add sErrorSource, "SOURCE"
    ErrorTreeStruct.Add Now
    
    'test the previous error - if its the same as the current error its a
    'recursive error and dont append it to the tree
    If ErrorTree.Count - 1 > 0 Then
        If ErrorTree.Item(ErrorTree.Count - 1).Item("SOURCE") = sErrorSource Then
            bResursion = True
        Else
            'if this call was recursive fail it
            ErrorTree.Add ErrorTreeStruct
        End If
    Else
        ErrorTree.Add ErrorTreeStruct
    End If
    
    Exit Function
PROC_ERROR:
    If Not bResursion Then
        'HandleError Err, "AutoLogger.modGeneral.AppendToErrorTree"
    End If
End Function
'************************************************************************************
'*****          AUTHOR:     ANTHONY PATTON
'*****          DATE:       03-09-2002
'*****          FUNCTION:   WRITES THE ERROR TREE TO A FILE AND EMAILS THE TREE
'*****                      TO THE RECIPIENTS IN THE DATABASE
'*****          COMMENTS:   PERFORMS THE NEEDED ROLLBACK AND ERROR REPORTING
'*****                      BY WRITING A FILE AND OR SENDING AN ERROR EMAIL
'************************************************************************************
Public Sub ProcessError()
    Dim iFree As Integer
    Dim sErrDesc As String
    Dim sErrNum As String
    Dim sErrSrc As String
    Dim sErr As String
    On Error GoTo PROC_ERROR
    
    'walk the error tree and dump it to a nice readable format
    sErr = WalkErrorTree
    
    'there was an error so roll back the transaction
    If Not (modGeneral.DBConnection Is Nothing) Then
        If Len(modGeneral.DBConnection.ConnectionString) > 0 Then
            modGeneral.DBConnection.RollbackTrans
        End If
    End If
    iFree = FreeFile
    
    'this is the generic error handler for the projeect
    Open "c:\temp\Autologger.err" For Append As #iFree
    Write #iFree, sErr
    Close #iFree
    
    'Call SendErrorMail(sErr)
    
    'shut the hell down
    'TerminateApp
    Exit Sub
PROC_ERROR:
    If Err.Number = -2147168242 Then  'no transaction active ado error
        'this is not a critical error, just means the trans has already been
        'rolled back (happens when more than one error is raised)
        Resume Next
    End If
    'Call HandleError(Err, "modGeneral.HandleError")
End Sub
'************************************************************************************
'*****          AUTHOR:     ANTHONY PATTON
'*****          DATE:       03-09-2002
'*****          FUNCTION:   WALKS THE ERROR TREE AND DUMPS IT TO A FILE
'*****          COMMENTS:   NONE
'************************************************************************************
Private Function WalkErrorTree() As String
    On Error GoTo PROC_ERROR
    Dim oErr As Object
    Dim sFomattedMsg As String
    Dim lErrCnt As Long
    Dim sIndent As String
    
    For lErrCnt = ErrorTree.Count To 1 Step -1
        sFomattedMsg = sFomattedMsg & sIndent & "Error Source: " & ErrorTree(lErrCnt).Item(3) & vbCrLf
        sFomattedMsg = sFomattedMsg & sIndent & "Error Description: " & ErrorTree(lErrCnt).Item(1) & vbCrLf
        sFomattedMsg = sFomattedMsg & sIndent & "Error Number: " & ErrorTree(lErrCnt).Item(2) & vbCrLf
        sFomattedMsg = sFomattedMsg & sIndent & "Error Date/Time: " & ErrorTree(lErrCnt).Item(4) & vbCrLf & vbCrLf
        sIndent = sIndent & vbTab
    Next
    WalkErrorTree = sFomattedMsg
    Exit Function
PROC_ERROR:
    'modGeneral.HandleError Err, "modError.WalkErrorTree"
End Function


